Developer CD Series 1996 May: Tool Chest/Developer CD Series May 1996 (Tool Chest) (Apple Computer) (1996).iso/Sample Code/Snippets/Printing/Rotated Thingies/…using Text PicComments/Rotn Text.p

Text File | 1992-07-15 | 11.8 KB | 488 lines | [TEXT/MPS ]

{**
 **     Program: Rotn Text
 **        7/25/91
 **
 **        MPW 3.2 Pascal source.
 **
 **     Purpose:
 **
 **        Rotn Text demonstrates how to rotate text on PostScript printers
 **        using the TextBegin/End PicComments.  PrGeneral is used to change
 **        the resolution, which throws another wrench in the works; you have
 **        to scale everything.
 **
 **        Dave Hersey
 **
 **        Macintosh Developer Technical Support
 **
 **        ----
 **             ver. 1.0    7/25/91        dmh
 **
 **}

PROGRAM RotnText;

USES
    MemTypes, QuickDraw, OSIntf, ToolIntf, Traps, MacPrint, Packages;

CONST

    {The following constants are used to identify menus and their items. The menu IDs
     have an "m" prefix and the item numbers within each menu have an "i" prefix.}

    rMenuBar    = 128;                    {menubar}

    mApple        = 128;                    {Apple menu}
    iAbout        = 1;

    mFile        = 129;                    {File menu}
    iPrint        = 1;
    iQuit        = 3;

    mEdit        = 130;                    {Edit menu}


VAR

    gQuitting    : Boolean;                {"Are we all done?" flag}


{*------ RotateText -----------------------------------------------------------------*}

{**
 **      RotateText draws the passed text rotated 45° using the TextBegin/End
 **      comments.  The center of rotation and start of text drawing is done
 **      at the "where" point passed.
 **}

{$S Main}
PROCEDURE RotateText(theText : Str255; where : Point);

    CONST
        TextBegin    = 150;
        TextEnd        = 151;
        TextCenter    = 154;

    TYPE
        TTxtCenterHdl    = ^TTxtCenterPtr;
        TTxtCenterPtr    = ^TTxtCenterRec;
        TTxtCenterRec    = RECORD
                            y, x: Fixed;    {offset from current pen location to center of rotation.}
                          END;     { TTxtCenterRec }

        TTxtPicHdl        = ^TTxtPicPtr;
        TTxtPicPtr        = ^TTxtPicRec;
        TTxtPicRec        = PACKED RECORD
                            tJus: Byte;        {0,1,2,3,4 -> none, left, center, right, full justification.}
                            tFlip: Byte;    {0,1,2 -> none, horizontal, vertical coordinate flip.}
                            tRot: integer;    {0..360 -> clockwise rotation in degrees.}
                            tLine: Byte;    {1,2,3.. -> single, 1 1/2, double.. spacing}
                            tCmnt: Byte;    {Reserved.}
                          END;     { TTxtPicRec }

    VAR
        txtHdl        : TTxtPicHdl;
        txtCtr        : TTxtCenterHdl;

    BEGIN

    {Do a dummy draw to set the clipping region.}

        PenSize(0, 0);
        MoveTo(0, 0);
        LineTo(0, 0);
        PenSize(1, 1);

        txtCtr := TTxtCenterHdl(NewHandle(SizeOf(TTxtCenterRec)));
        txtCtr^^.y := 0; {no y offset to center of rotation}
        txtCtr^^.x := 0; {no x offset to center of rotation}

        txtHdl := TTxtPicHdl(NewHandle(SizeOf(TTxtPicRec)));
        txtHdl^^.tJus := 0;     {no justification}
        txtHdl^^.tFlip := 0; {no flip}
        txtHdl^^.tRot := 45; {45° rotation}
        txtHdl^^.tLine := 1; {single spacing}

    {Begin text rotation.}

        PicComment(TextBegin,GetHandleSize(handle(txtHdl)),handle(txtHdl));

    {Set the center of rotation and draw.}

        MoveTo(where.h, where.v);
        PicComment(TextCenter,GetHandleSize(handle(txtCtr)),handle(txtCtr));

        DrawString(theText);

    {Text rotation ends here.}

        PicComment(TextEnd,0,NIL);
        DisposHandle(handle(txtHdl)); {Clean up}
        DisposHandle(handle(txtCtr));

    END;    {**  RotateText  **}


{*------ DrawStuff -----------------------------------------------------------------*}

{**
 **      DrawStuff draws the objects.  prRsl is the resolution of the printer's
 **        GrafPort and is used to determine the amount to scale everything.
 **}

{$S Main}
 PROCEDURE DrawStuff(theGPort : GrafPtr; prRsl : Integer);

 VAR
    oldPort        : GrafPtr;
    fNum        : Integer;
    scalar        : Real;
    where        : Point;

 BEGIN

{Get the current port and save it.}

    GetPort(oldPort);
    SetPort(theGPort);

    scalar := prRsl;
    scalar := scalar / 72;

    GetFNum('Times', fNum);
    TextFont(fNum);
    TextSize(Round(24 * scalar));

    where.h := Round(50 * scalar);
    where.v := Round(50 * scalar);
    RotateText('This is a line of rotated text.', where);

    SetPort(oldPort);

 END;    {**  DrawStuff  **}


{*------ GetBestRsl -----------------------------------------------------------------*}

{**
 **      GetBestRsl determines the best "square" resolution supported by the printer.
 **        For example, 300 dpi horizontal by 300 dpi vertical.  It isn't necessary to
 **        use square resolutions, but it generally proves easier.  We use PrGeneral and
 **        the getRslDataOp opCode to get a list of the supported resolutions for our
 **        printer.  Then we just go through the rgRslRec and find the maximum square
 **        resolution for discrete or non-discrete data, whichever we have.  Finally, we
 **        make sure it's divisible by 72 for cleaner scaling.
 **}

{$S Main}
FUNCTION GetBestRsl :Integer;

VAR
        err            : OSErr;
        theRes, num    : Integer;
        getRslData    : TGetRslBlk;

BEGIN

{Start off with our maximum resolution at 0, then call PrGeneral and parse our list
 of returned values.}

        theRes := 0;
        getRslData.iOpCode := getRslDataOp;

        PrGeneral(@getRslData);
        err := getRslData.iError;

{If our printer only supports discrete resolutions, find the largest square one and
 use that.  If our printer supports a range of resolutions, choose the smaller of the
 maximum X and Y resolutions, then make it divisible by 72 for cleaner scaling.}

        IF (err = noErr) THEN
            IF (getRslData.XRslRg.iMax = 0) AND (getRslData.YRslRg.iMax = 0) THEN
                BEGIN                                                                {Discrete resolutions.}
                    FOR num := 1 TO getRslData.iRslRecCnt DO
                        IF (getRslData.rgRslRec[num].iXRsl = getRslData.rgRslRec[num].iYRsl)
                            AND (theRes < getRslData.rgRslRec[num].iXRsl) THEN
                                theRes := getRslData.rgRslRec[num].iXRsl;
                END
            ELSE
                BEGIN                                                                {Variable resolutions.}
                    IF (getRslData.XRslRg.iMax < getRslData.YRslRg.iMax) THEN
                        theRes := (getRslData.XRslRg.iMax DIV 72) * 72            {Use multiple of 72 closest to max. X resolution.}
                    ELSE
                        theRes := (getRslData.YRslRg.iMax DIV 72) * 72            {Use multiple of 72 closest to max. Y resolution.}
                END;


{In the unlikely event that PrGeneral fails and theRes is still 0, set it to 72.
 This most likely is a supported resolution.  Finally return the best resolution we
 could find.}

        IF theRes = 0 THEN theRes := 72;
        GetBestRsl := theRes;

END;    {**  GetBestRsl  **}


{*------ PrintStuff ----------------------------------------------------------------*}
{**
 **        PrintStuff will call all of the necessary Print Manager calls to print
 **        a document. It checks PrError after each Print Manager call. If an error
 **     is found, all of the Print Manager open calls (i.e. PrOpen, PrOpenDoc...)
 **        will have a corresponding close call before the error is posted to the user.
 **        You want to use this approach to make sure the Print Manager closes properly
 **        and all temporary memory is released.
 **}

{$S Main}
PROCEDURE PrintStuff;

VAR
    Loop,
    NumberOfPages,
    PageNumber        : Integer;
    PrintError        : LongInt;
    oldPort          : GrafPtr;
    thePrRecHdl        : THPrint;
    thePrPort        : TPPrPort;
    theStatus        : TPrStatus;
    errStr            : Str255;
    rslData            : TSetRslBlk;
    err                : OSErr;
    prRsl            : Integer;
    setMHdl            : MenuHandle;
    mark            : Char;
    bestRsl            : Integer;

BEGIN


{Get our current port and create a print handle.  If no errors,
 do our PrOpen call and, if no errors again, get the default
 settings for the current driver.}

    GetPort(oldPort);
    thePrRecHdl := THPrint(NewHandle(sizeof(TPrint)));

    IF (MemError = noErr) THEN
    BEGIN
        PrOpen;
        IF (PrError = noErr) THEN
        BEGIN
            PrintDefault(thePrRecHdl);

            bestRsl := GetBestRsl;
            rslData.iOpCode := SetRslOp;
            rslData.hPrint := thePrRecHdl;
            rslData.iXRsl := bestRsl;
            rslData.iYRsl := bestRsl;
            PrGeneral(@rslData);
            err := rslData.iError;

            prRsl := bestRsl;


{If we still have no errors, give style and print job dialogs, then open a
 document and its page.  Keep checking for those dang printer errors.}

            IF (PrError = noErr) THEN
            BEGIN
                IF (PrStlDialog(thePrRecHdl)) THEN
                BEGIN
                    IF (PrJobDialog(thePrRecHdl)) THEN
                    BEGIN
                        thePrPort := PrOpenDoc(thePrRecHdl, NIL, NIL);

                        IF (PrError = noErr) THEN
                        BEGIN
                            PrOpenPage(thePrPort, NIL);


{If we're still running error-free, draw our test page.  prRsl is the
 resolution of our printer port.}

                            IF (PrError = noErr) THEN
                                DrawStuff(GrafPtr(thePrPort), prRsl);


{When done, close our page and document and spool the document if necessary.  When
 finshed, call PrClose to end the whole shabang.}

                            PrClosePage(thePrPort);
                        END;

                        PrCloseDoc(thePrPort);

                        IF (thePrRecHdl^^.prJob.bJDocLoop = bSpoolLoop) and (PrError = noErr) THEN
                            PrPicFile(thePrRecHdl, NIL, NIL, NIL, theStatus);
                    END;
                END;
            END;
        END;

        PrClose;

    END;

END;    {**  PrintStuff  **}


{*------ Initialize ----------------------------------------------------------------*}
{**
 **        Initialize just handles necessary Toolbox initializing, setting our quitting
 **        flag to FALSE and installing our menus.
 **}

{$S Initialize}
PROCEDURE Initialize;

VAR
    menuBar    : Handle;

BEGIN

    InitGraf(@thePort);
    InitFonts;
    InitWindows;
    InitMenus;
    TEInit;
    InitDialogs(NIL);
    InitCursor;
    FlushEvents(everyEvent, 0);

    gQuitting := FALSE;

    menuBar := GetNewMBar(rMenuBar);        {read menus into menu bar}
    IF (menuBar = NIL) THEN ExitToShell;    {should do real error stuff here.}
    SetMenuBar(menuBar);                    {install menus}
    DisposHandle(menuBar);
    AddResMenu(GetMHandle(mApple), 'DRVR');    {add DA names to Apple menu}
    DrawMenuBar;

END;    {**  Initialize  **}


{$S _DataInit}
PROCEDURE _DataInit; EXTERNAL;

{This routine is automatically linked in by the MPW Linker. This external
 reference to it is done so that we can unload its segment, %A5Init.}



{*------ DoMenuCommand ----------------------------------------------------------------*}
{**
 **        DoMenuCommand is called when an item is chosen from the menu bar (after calling
 **        MenuSelect or MenuKey).  It does the right thing for each command.
 **}

{$S Main}
PROCEDURE DoMenuCommand(menuResult: LONGINT);

VAR
    menuID, menuItem    : INTEGER;
    daRefNum            : INTEGER;
    daName                : Str255;

BEGIN

{Get the menu ID and item ID.}

    menuID := HiWrd(menuResult);
    menuItem := LoWrd(menuResult);

    CASE menuID OF
        mApple:
            CASE menuItem OF
                iAbout:                {bring up alert for About}
                    (* We do nothing here... *);

                OTHERWISE
                BEGIN        {all non-About items in this menu are DAs}
                    GetItem(GetMHandle(mApple), menuItem, daName);
                    daRefNum := OpenDeskAcc(daName);
                END;
            END;

        mFile:                            {File Menu}
            CASE menuItem OF
                iPrint:                        {-> Print Test Page.}
                    PrintStuff;
                iQuit:
                    gQuitting := TRUE;        {-> Quit}
            END;
    END;

    HiliteMenu(0);

END;    {**  DoMenuCommand  **}


{*------ DoEvent ----------------------------------------------------------------*}
{**
 **        DoEvent handles incoming events for our app.  In this skimpy sample, we
 **        only handle menu events and system clicks.
 **}

{$S Main}
PROCEDURE DoEvent;

VAR
    part        : INTEGER;
    key            : Char;
    quitting    : Boolean;
    event        : EventRecord;
    window        : WindowPtr;

BEGIN

{Repeatedly handle menu selecting events until our quit flag is set.}

    REPEAT
        BEGIN
            SystemTask;                                    {This must be called if using GetNextEvent}

            IF (GetNextEvent(everyEvent, event)) THEN
                CASE event.what OF
                    mouseDown:
                        BEGIN
                            part := FindWindow(event.where, window);
                            CASE part OF
                                inMenuBar:
                                    DoMenuCommand(MenuSelect(event.where));

                                inSysWindow:
                                    SystemClick(event, window);
                            END;
                        END;

                    keyDown, autoKey:
                        BEGIN
                            key := CHR(BAnd(event.message, charCodeMask));
                            IF (BAnd(event.modifiers, cmdKey) <> 0) AND (event.what = keyDown) THEN
                                DoMenuCommand(MenuKey(key));
                        END;
                END;
        END;
    UNTIL gQuitting;

END;    {**  DoEvent  **}


{*------ Main ----------------------------------------------------------------*}
{**
 **        Main kickstarts our app.
 **}

{$S Main}
BEGIN

    UnloadSeg(@_DataInit);    {note that _DataInit must not be in Main!}
    MaxApplZone;            {expand the heap so code segments load at the top}
    Initialize;                {initialize the program}
    UnloadSeg(@Initialize);    {note that Initialize must not be in Main!}
    DoEvent;                {handle menu events until quitting.}

END.    {**  Rotn Text.  **}